home *** CD-ROM | disk | FTP | other *** search
/ Aminet 12 / Aminet 12 (1996)(GTI - Schatztruhe)[!][Jun 1996].iso / Aminet / dev / e / eiffel.lha / flc / source / procedure.e < prev    next >
Encoding:
Text File  |  1996-01-14  |  4.6 KB  |  207 lines
  1.  
  2. -> Copyright © 1995, Guichard Damien.
  3.  
  4. -> Eiffel procedures
  5.  
  6. -> Procedures have their own arguments and local variables.
  7.  
  8. -> TO DO :
  9. ->   more stuff for obsolete routines
  10. ->   redefinition to a variable attribute
  11. ->   preconditions
  12. ->   postconditions
  13. ->   once routines
  14. ->   external routines
  15.  
  16. OPT MODULE
  17.  
  18. MODULE '*strings','*entity_tree'
  19. MODULE '*ame'
  20. MODULE '*class','*feature','*local','*argument'
  21.  
  22. DEF local_count
  23. DEF locals:PTR TO entity_tree
  24.  
  25. ENUM NOT_CREATOR,CREATOR
  26.  
  27. EXPORT OBJECT procedure OF feature
  28. PUBLIC
  29.   arguments:PTR TO argument
  30. PRIVATE
  31.   frozen:CHAR
  32.   deferred:CHAR
  33.   creator:CHAR
  34.   creation_client:PTR TO class
  35.   count:INT
  36. ENDOBJECT
  37.  
  38. -> Set count of the feature
  39. PROC set_count(count) OF procedure
  40.   self.count:=count
  41. ENDPROC
  42.  
  43. -> Freeze this feature.
  44. PROC freeze() OF procedure
  45.   self.frozen:=TRUE
  46. ENDPROC
  47.  
  48. -> Defer this feature.
  49. PROC defer() OF procedure
  50.   self.deferred:=TRUE
  51. ENDPROC
  52.  
  53. -> Is procedure deferred?
  54. PROC is_deferred() OF procedure
  55. ENDPROC self.deferred
  56.  
  57. -> Turn this procedure into a creator
  58. PROC as_creator(class:PTR TO class,client) OF procedure
  59.   DEF other:PTR TO procedure
  60.   IF self.class=class
  61.     self.creator:=TRUE
  62.     self.creation_client:=client
  63.   ELSE
  64.     NEW other
  65.     other.name:=self.name
  66.     other.client:=self.client
  67.     other.type:=self.type
  68.     other.arguments:=self.arguments
  69.     other.frozen:=self.frozen
  70.     other.creator:=TRUE
  71.     other.creation_client:=client
  72.     other.count:=self.count
  73.     class.add_feature(other)
  74.   ENDIF
  75. ENDPROC
  76.  
  77. -> Is this procedure a creator?
  78. PROC is_creator(class:PTR TO class,client:PTR TO class) OF procedure
  79.   IF self.class<>class THEN RETURN FALSE
  80.   IF self.creator=FALSE THEN RETURN FALSE
  81. ENDPROC client.is_heir_of(self.creation_client)
  82.  
  83. -> Is feature frozen?
  84. PROC is_frozen() OF procedure IS self.frozen
  85.  
  86. -> Is feature a routine?
  87. PROC is_routine() OF procedure IS TRUE
  88.  
  89. -> Is feature a procedure?
  90. PROC is_procedure() OF procedure IS TRUE
  91.  
  92. -> Feature value access mode
  93. PROC access() OF procedure IS M_NONE
  94.  
  95. -> Vector for routine call
  96. PROC vector() OF procedure IS self.count
  97.  
  98. -> Add procedure arguments.
  99. PROC add_arguments(arguments:PTR TO argument) OF procedure
  100.   IF locals=NIL THEN NEW locals
  101.   self.arguments:=arguments
  102. ENDPROC
  103.  
  104. -> Find an argument.
  105. PROC find_argument(name) OF procedure
  106. ENDPROC IF self.arguments THEN self.arguments.find(name) ELSE NIL
  107.  
  108.  
  109. -> Add a local.
  110. PROC add_local(local:PTR TO local) OF procedure
  111.   INC local_count
  112.   local.set_count(local_count)
  113.   locals.add(local)
  114. ENDPROC
  115.  
  116. -> Find a local.
  117. PROC find_local(name) OF procedure
  118. ENDPROC locals.find(name)
  119.  
  120. -> Local entities.
  121. PROC local_entities() OF procedure
  122. ENDPROC local_count
  123.  
  124. -> Wipe out locals.
  125. PROC wipe_out_locals() OF procedure
  126.   local_count:=0
  127.   IF locals THEN locals.wipe_out()
  128. ENDPROC
  129.  
  130. -> Make a copy renamed with 'name'
  131. PROC rename(name) OF procedure
  132.   DEF other:PTR TO procedure
  133.   other:=self.copy()
  134.   other.name:=clone(name)
  135.   other.client:=self.client
  136.   other.type:=self.type
  137.   other.arguments:=self.arguments
  138.   other.frozen:=self.frozen
  139.   other.deferred:=self.deferred
  140.   other.count:=self.count
  141. ENDPROC other
  142.  
  143. -> Make a copy exported to 'client'
  144. PROC new_exports(client) OF procedure
  145.   DEF other:PTR TO procedure
  146.   other:=self.copy()
  147.   other.name:=self.name
  148.   other.client:=client
  149.   other.type:=self.type
  150.   other.arguments:=self.arguments
  151.   other.frozen:=self.frozen
  152.   other.deferred:=self.deferred
  153.   other.count:=self.count
  154. ENDPROC other
  155.  
  156. -> Make an undefined copy.
  157. PROC undefine() OF procedure
  158.   DEF other:PTR TO procedure
  159.   other:=self.copy()
  160.   other.name:=self.name
  161.   other.client:=self.client
  162.   other.type:=self.type
  163.   other.arguments:=self.arguments
  164.   other.frozen:=self.frozen
  165.   other.deferred:=TRUE
  166.   other.count:=self.count
  167. ENDPROC other
  168.  
  169. -> Make a copy redefined with 'client','arguments','type'
  170. PROC redefine(client,arguments,type) OF procedure
  171.   DEF other:PTR TO procedure
  172.   other:=self.copy()
  173.   other.name:=self.name
  174.   other.client:=client
  175.   other.type:=type
  176.   other.arguments:=arguments
  177.   other.count:=self.count
  178. ENDPROC other
  179.  
  180. -> Is signature conform to procedure signature
  181. PROC is_conform(arguments:PTR TO argument,type:PTR TO class) OF procedure
  182.   DEF p:PTR TO argument
  183.   DEF q:PTR TO argument
  184.   DEF result:PTR TO class
  185.   p:=arguments
  186.   q:=self.arguments
  187.   WHILE TRUE
  188.     EXIT p=NIL
  189.     EXIT q=NIL
  190.     result:=p.type.base()
  191.     IF result.is_heir_of(q.type.base())=FALSE THEN RETURN FALSE
  192.     p:=p.next
  193.     q:=q.next
  194.   ENDWHILE
  195.   IF p THEN RETURN FALSE
  196.   IF q THEN RETURN FALSE
  197.   IF type=NIL THEN RETURN self.type=NIL
  198.   IF self.type=NIL THEN RETURN FALSE
  199.   result:=type.base()
  200. ENDPROC result.is_heir_of(self.type.base())
  201.  
  202. -> Make a procedure.
  203. PROC copy() OF procedure
  204.   DEF other:PTR TO procedure
  205. ENDPROC NEW other
  206.  
  207.